home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / DATE-.PRG < prev    next >
Encoding:
Text File  |  1984-08-12  |  3.0 KB  |  106 lines
  1. * Program.: DATE-.PRG
  2. * Author..: Luis A. Castro
  3. * Date....: 01/19/84 
  4. * Notice..: Copyright 1984, Luis A. Castro, All Rights Reserved.
  5. * Version.: dBASE II, version 2.4x
  6. * Notes...: Front-end program to utilize DATETEST, 
  7. *           WEEKDAY, JUL2CAL, and CAL2JUL subroutines.
  8. * Local...: select, mdate, row, string, is:error, julian
  9. *
  10. SET TALK OFF 
  11. SET BELL OFF
  12. SET COLON OFF
  13. SET RAW ON
  14. ERASE
  15. @ 2, 0 SAY "DEMONSTRATION of DATE ROUTINES"
  16. @ 2,72 SAY DATE()
  17. @ 3, 0 SAY "========================================"
  18. @ 3,40 SAY "========================================"
  19. STORE 11 TO row
  20. STORE "X" TO select
  21. DO WHILE select <> " "
  22.    @ 10,0
  23.    STORE " " TO select
  24.    @ 5,0 SAY "1. CAL2JUL()  =  calendar to julian conversion"
  25.    @ 6,0 SAY "2. JUL2CAL()  =  julian to calendar conversion"
  26.    @ 7,0 SAY "3. DATETEST() =  verify a date"
  27.    @ 8,0 SAY "4. WEEKDAY()  =  day of the week"
  28.    @ 9,0 GET select PICTURE "!"
  29.    READ
  30.    IF select = " " .OR. .NOT. select $ "1234"
  31.       LOOP
  32.    ENDIF
  33.    @ 9,0 SAY " "
  34.    STORE "  /  /  " TO mdate
  35.    STORE "0     " TO string
  36.    * ---Enter date parameter.
  37.    DO CASE
  38.       CASE select $ "14"
  39.          @ 10,0 SAY "ENTER DATE as MM/DD/YY ";
  40.                 GET mdate PICTURE "99/99/99"
  41.       CASE select = "2"
  42.          @ 10,0 SAY "ENTER JULIAN DATE as 999999 ";
  43.                 GET string PICTURE "999999"
  44.       CASE select = "3"
  45.          STORE "  /  /    " TO mdate
  46.          @ 10,0 SAY "ENTER DATE as MM/DD/YY or MM/DD/YYYY ";
  47.                 GET mdate PICTURE "99/99/9999"
  48.    ENDCASE
  49.    READ
  50.    IF mdate = "  /  /  " .AND. "0" = TRIM(string)
  51.       LOOP
  52.    ENDIF
  53.    STORE VAL(string) TO julian
  54.    @ row,0 SAY " "
  55.    *
  56.    * ---Execute a date routine.
  57.    DO CASE
  58.       CASE select = "1"
  59.       * ---CALENDAR TO JULIAN CONVERSION.
  60.          ? "   CAL2JUL (",mdate,") ="
  61.          * ---First, verify the date.
  62.          DO Datetest 
  63.          * ---Now, get the julian date.
  64.          IF is:error
  65.             ?? " invalid date"
  66.          ELSE
  67.             DO Cal2jul
  68.             ?? julian
  69.          ENDIF
  70.       CASE select = "2"
  71.       * ---JULIAN TO CALENDAR CONVERSION.
  72.          ? "   JUL2CAL (",TRIM(string),") =  "
  73.          DO Jul2cal
  74.          ?? mdate
  75.       CASE select = "3"
  76.       * ---VERIFY A DATE.
  77.          ? "   DATETEST (",mdate,") =  "
  78.          DO Datetest
  79.          IF is:error
  80.             ?? '"invalid"'
  81.          ELSE
  82.             ?? '"valid"'
  83.          ENDIF
  84.       CASE select = "4"
  85.       * ---DAY OF THE WEEK.
  86.          * ---First, verify the date.
  87.          DO Datetest 
  88.          * ---Now, get the day of the week.
  89.          ? "   WEEKDAY (",mdate,") =  "
  90.          IF is:error
  91.             ?? "invalid date"
  92.          ELSE
  93.             DO Weekday
  94.             ?? week:num, " - " + week:day
  95.          ENDIF
  96.    ENDCASE
  97.    STORE row + 1 TO row
  98. ENDDO
  99. SET BELL ON
  100. SET TALK ON
  101. SET COLON ON
  102. SET RAW OFF
  103. RELEASE select, mdate, row
  104. RETURN
  105. * EOF: DATE-.PRG
  106.